home *** CD-ROM | disk | FTP | other *** search
/ Commodore Disk User Volume 3 #12 / Commodore_Disk_User_Vol.3_12_1990_-.d64 / roll 'em (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  8KB  |  366 lines
  1. 1 rem ************************
  2. 2 rem *                      *
  3. 3 rem *   graphics factory   *
  4. 4 rem *    animation demo    *
  5. 5 rem * "roll 'em", (c) 1989 *
  6. 6 rem *  by: m.h.westerweel  *
  7. 7 rem *                      *
  8. 8 rem ************************
  9. 9 :
  10. 10 rem action control unit
  11. 15 rem ===================
  12. 20 :
  13. 25 poke53280,14:poke646,14:poke53281,6
  14. 26 gosub1245:fi$="cr/roll*":gosub1145
  15. 30 prints1$spc(8)i$" [144]";
  16. 35 getyn$:ifyn$<>"n"andyn$<>"y"then35
  17. 40 printyn$"[145]":ifyn$="n"then50
  18. 45 gosub1645:poke53272,21
  19. 50 fi$="cr/action dice":gosub1145
  20. 55 :
  21. 60 gosub970:co=1:x=1:q=q+1:ifq>nthenq=1
  22. 65 forsb=4to10:sb(sb)=0:next:od=0:do=0
  23. 70 :
  24. 75 rs=0:gosub860
  25. 80 ifx=1thengosub155:gosub270
  26. 85 :
  27. 90 :forop=3to5:print"[129]"op$(op):next
  28. 95 :print"[146][144]"d1$(d1)d2$(7-d2)
  29. 100 gosub895:oncogoto105,115
  30. 105 gosub425:ifx<>2thengosub1195
  31. 110 goto120
  32. 115 gosub560:ifdt<4ordt>10thengosub1195
  33. 120 print"[146][144]"dt$(dt):oncogoto125,90
  34. 125 onxgoto60,75
  35. 130 :
  36. 135 rem enter bet
  37. 140 rem =========
  38. 145 :
  39. 150 rem number entry processor
  40. 155 prints1$"[156]  [144]return[156] accepts ";
  41. 160 print"bet, [144]del[156] deletes bet.[145]"
  42. 165 bt$="":printfb$(2)er$"";
  43. 170 gettb$:iftb$=""thengosub240:goto170
  44. 175 iftb$<>chr$(13)orbt$=""then190
  45. 180 bt=val(bt$):ifbt<5then165
  46. 185 print" "s1$"[156]"z$"[145]":bt$="":return
  47. 190 iftb$<>chr$(20)orbt$=""then205
  48. 195 bt$=left$(bt$,len(bt$)-1)
  49. 200 print"[157][144]? [157][157]";
  50. 205 iftb$<"0"ortb$>"9"then220
  51. 210 iflen(bt$)>2then220
  52. 215 bt$=bt$+tb$:printtb$"[144]?[157]";
  53. 220 ifbt$=""orleft$(bt$,1)="0"then165
  54. 225 gettb$:goto175
  55. 230 :
  56. 235 rem flashing cursor
  57. 240 forrv=1to2:printv$(rv)"[144]?[157]";
  58. 245 forw=1to100:nextw:next:return
  59. 250 :
  60. 255 rem get pass or no pass
  61. 260 rem ===================
  62. 265 :
  63. 270 getpn$
  64. 275 ifpn$="p"thenprintpn$(1):goto295
  65. 280 ifpn$="n"thenprintpn$(2)x$:goto295
  66. 285 forpn=1to2:printpn$(pn)
  67. 290 forw=1to100:nextw:next:goto270
  68. 295 return
  69. 300 :
  70. 305 rem get collect or gamble
  71. 310 rem =====================
  72. 315 :
  73. 320 getcg$
  74. 325 ifcg$="c"thenprintcg$(1):goto345
  75. 330 ifcg$="g"thenprintcg$(2):goto345
  76. 335 forcg=1to2:printcg$(cg)
  77. 340 forw=1to100:nextw:next:goto320
  78. 345 return
  79. 350 :
  80. 355 rem get gamble or roll
  81. 360 rem ==================
  82. 365 :
  83. 370 getgr$
  84. 375 ifgr$="g"thenprintgr$(1):goto395
  85. 380 ifgr$="r"thenprintgr$(2):goto395
  86. 385 forgr=1to2:printgr$(gr)
  87. 390 forw=1to100:nextw:next:goto370
  88. 395 return
  89. 400 :
  90. 405 rem come out roll
  91. 410 rem =============
  92. 415 :
  93. 420 rem come out = pass
  94. 425 ifpn$<>"p"then455
  95. 430 ifdt>7then440
  96. 435 ondtgoto430,480,480,520,520,520,490
  97. 440 on(dt-7)goto520,520,520,480,480
  98. 445 :
  99. 450 rem come out = no pass
  100. 455 ifdt>7then465
  101. 460 ondtgoto425,490,490,520,520,520,480
  102. 465 on(dt-7)goto520,520,520,490,490
  103. 470 :
  104. 475 rem come out : win/loss
  105. 480 rs=-bt:b(q)=b(q)+rs:gosub860
  106. 485 gosub1020:x=1:goto530
  107. 490 rs=bt:gosub860:forpp=1to5:gosub1055
  108. 495 next:x=2:b(q)=b(q)+rs:gosub320
  109. 500 gosub860:ifcg$<>"g"then530
  110. 505 bt=2*bt:gosub860:goto530
  111. 510 :
  112. 515 rem come out : point made
  113. 520 od=bt:do=od:r=1:gosub815
  114. 525 x=1:co=2:sb(dt)=bt:tb=bt:bt=0
  115. 530 return
  116. 535 :
  117. 540 rem points routine
  118. 545 rem ==============
  119. 550 :
  120. 555 rem (pass) points before 7
  121. 560 ifpn$<>"p"then590
  122. 565 ifdt>7then575
  123. 570 ondtgoto560,790,790,615,615,615,700
  124. 575 on(dt-7)goto615,615,615,790,790
  125. 580 :
  126. 585 rem (no pass) 7 before points
  127. 590 ifdt>7then600
  128. 595 ondtgoto560,790,790,615,615,615,730
  129. 600 on(dt-7)goto615,615,615,790,790
  130. 605 :
  131. 610 rem gamble or roll?
  132. 615 ifsb(dt)=0then630
  133. 620 ifpn$="n"then700
  134. 625 ifpn$="p"then655
  135. 630 gosub370:ifgr$="r"then790
  136. 635 sb(dt)=tb:od=sb(dt):do=do+tb
  137. 640 r=1:gosub815:goto790
  138. 645 :
  139. 650 rem (pass=win) collect or gamble?
  140. 655 forw=1to5:gosub1055:next
  141. 660 rs=sb(dt)*py(dt):rs=int(rs+.5)
  142. 665 gosub860:gosub320:b(q)=b(q)+rs
  143. 670 ifcg$<>"g"thenrs=0:gosub860:goto790
  144. 675 sb(dt)=sb(dt)+rs:od=sb(dt):do=do+rs
  145. 680 rs=0:r=1:gosub815:gosub860:goto790
  146. 685 :
  147. 690 rem (pass=loss)    : seven out
  148. 695 rem (no pass=loss) : point repeats
  149. 700 gosub1020:rs=0:forsb=4to10
  150. 705 rs=rs-sb(sb):next:b(q)=b(q)+rs
  151. 710 gosub860:gosub1195:co=1
  152. 715 gosub1165:x=1:goto790
  153. 720 :
  154. 725 rem (no pass=win) : 7 before point
  155. 730 forw=1to5:gosub1055:next:ct=0
  156. 735 rs=0:forsb=4to10:py=sb(sb)*(yp(sb))
  157. 740 rs=rs+py:ifsb(sb)>0thenct=ct+1
  158. 745 next:rs=int((ct*rs)+.5)
  159. 750 gosub860:gosub320:b(q)=b(q)+rs:rs=0
  160. 755 gosub860:ifcg$<>"g"then785
  161. 760 do=0:forsb=4to10:py=sb(sb)*(yp(sb))
  162. 765 sb(sb)=sb(sb)+int((ct*py)+.5)
  163. 770 dt=sb:ifsb(sb)=0then780
  164. 775 od=sb(sb):do=do+sb(sb):r=2:gosub815
  165. 780 next:rs=0:gosub860
  166. 785 ct=0:print"[146][144]"dt$(7)
  167. 790 return
  168. 795 :
  169. 800 rem print side bet on point box
  170. 805 rem ===========================
  171. 810 :
  172. 815 printfb$(2)er$fb$(3)""do
  173. 820 od$=str$(od)
  174. 825 od$=right$(od$,len(od$)-1)
  175. 830 printv$(r)dt$(dt)"[145][145][145][157][157][157][157]"od$
  176. 835 return
  177. 840 :
  178. 845 rem print results
  179. 850 rem =============
  180. 855 :
  181. 860 printfb$(1)er$" "pl$(q)fb$(2)er$;bt
  182. 865 printfb$(3)er$;do;fb$(4)er$;rs
  183. 870 printfb$(5)er$;b(q):return
  184. 875 :
  185. 880 rem shake, rattle & roll
  186. 885 rem ====================
  187. 890 :
  188. 895 d1=int(6*rnd(1))+1
  189. 900 d2=int(6*rnd(1))+1
  190. 905 ford=1to3:fordd=1to6
  191. 910 printv$(d)d1$(dd)d2$(7-dd)
  192. 915 poke54296,15:poke54296,0
  193. 920 next:next:fordd=1to6
  194. 925 ifdd<>d1thenprintd1$(dd)
  195. 930 ifdd<>d2thenprintd2$(7-dd)
  196. 935 poke54296,15:poke54296,0:next
  197. 940 dt=(7-d1)+(7-d2)
  198. 945 print"[144]"dt$(dt):return
  199. 950 :
  200. 955 rem reset screen
  201. 960 rem ============
  202. 965 :
  203. 970 fortd=2to12:print"[146][144]"dt$(td);
  204. 975 print"[145][145][145][157][157][157][157]    ":next:co=1
  205. 980 forop=1to5:print"[129]"op$(op):next
  206. 985 print"[146][144]"d1$(d1)d2$(7-d2)y$
  207. 990 return
  208. 995 :
  209. 1000 rem sound effects
  210. 1005 rem =============
  211. 1010 :
  212. 1015 rem "buzz" for loss
  213. 1020 pokes+3,10:pokes+2,5:pokes+5,15
  214. 1025 pokes+6,0:pokes+24,15:pokes+1,5
  215. 1030 pokes,127:pokes+4,65:fort=1to500
  216. 1035 next:pokes+4,64:fort=1to100:next
  217. 1040 return
  218. 1045 :
  219. 1050 rem "ping" for win
  220. 1055 pokes+3,120:pokes+2,127:pokes+5,10
  221. 1060 pokes+6,10:pokes+24,15:pokes+1,90
  222. 1065 pokes,127:pokes+4,65:fort=1to100
  223. 1070 next:pokes+4,64:fort=1to50:next
  224. 1075 return
  225. 1080 :
  226. 1085 rem print canvas
  227. 1090 rem ============
  228. 1095 :
  229. 1100 zz=0:print"";:forz=1to24
  230. 1105 print"[156]"z$:zz=zz+40
  231. 1110 poke55295+zz,4:poke1023+zz,160
  232. 1115 next:print"[156]"z$"[145]":poke56295,4
  233. 1120 poke2023,160:return
  234. 1125 :
  235. 1130 rem print screen files
  236. 1135 rem ==================
  237. 1140 :
  238. 1145 open8,8,8,"0:"+fi$+",s,r"
  239. 1150 forf=1to23:input#8,f1$:input#8,f2$
  240. 1155 fl$(f)=f1$+f2$:next:close8
  241. 1160 gosub1100
  242. 1165 print"";:forf=1to23
  243. 1170 print""fl$(f):next:return
  244. 1175 :
  245. 1180 rem space bar prompt
  246. 1185 rem ================
  247. 1190 :
  248. 1195 prints1$spc(8)sb$"...[145]"
  249. 1200 forw=1to100:nextw
  250. 1205 prints1$spc(8)bs$"...[145]"
  251. 1210 forw=1to100:nextw
  252. 1215 getdr$:ifdr$<>" "then1195
  253. 1220 prints1$"[156]"z$"[145]":return
  254. 1225 :
  255. 1230 rem enter players
  256. 1235 rem =============
  257. 1240 :
  258. 1245 print"[147] number of players (1-9)";
  259. 1250 inputn$:n=val(n$)
  260. 1255 ifn<1orn>9then1245
  261. 1260 fornn=1ton:print"[147] player";nn;
  262. 1265 inputpl$(nn):pl=len(pl$(nn))
  263. 1270 ifpl>0andpl<10then1285
  264. 1275 print" ...9 letters max!!!"
  265. 1280 nn=nn-1:forw=1to1500:nextw
  266. 1285 next:print"[147]"
  267. 1290 :
  268. 1295 rem set up graphics
  269. 1300 rem ===============
  270. 1305 :
  271. 1310 rem initialize:
  272. 1315 rem grafix, rnd, sounds, pay outs
  273. 1320 dimfl$(23),dt$(12):t=rnd(-ti)
  274. 1325 poke53281,15:poke53280,4
  275. 1330 forz=1to39:z$=z$+" ":next
  276. 1335 gosub1100:print"[146][144]"spc(12);
  277. 1340 print" setting up... "
  278. 1345 s=54272:forl=stos+24:pokel,0:next
  279. 1350 py(4)=2:py(5)=1.5:py(6)=1.2
  280. 1355 py(10)=2:py(9)=1.5:py(8)=1.2
  281. 1360 yp(4)=.5:yp(5)=.6667:yp(6)=.8333
  282. 1365 yp(10)=.5:yp(9)=.6667:yp(8)=.8333
  283. 1370 :
  284. 1375 rem field square strings
  285. 1380 s1$=""
  286. 1385 forr1=1to36:r1$=r1$+"":next
  287. 1390 t1$=" 2 3 4 5 6 7 8 9101112"
  288. 1395 q$="[157][157][157][157]":fordt=2to12:reads2,r2
  289. 1400 s2$=left$(s1$,s2)
  290. 1405 r2$=left$(r1$,r2)
  291. 1410 m$=mid$(t1$,(dt-1)*2-1,2)
  292. 1415 t2$="[207][183][183][208]"+q$+"[180]"+m$+"[170]"+q$+"[204][175][175][186]"
  293. 1420 dt$(dt)=s2$+r2$+t2$:next
  294. 1425 data 10,6,11,10,5,6,4,10,3,14,11
  295. 1430 data 18,3,22,4,26,5,30,11,26,10,30
  296. 1435 :
  297. 1440 rem dice face strings
  298. 1445 a$="   ":b$="  [209]":c$=" [209] "
  299. 1450 d$="[209]  ":e$="[209] [209]":f$="[157][157][157]"
  300. 1455 dd$(1)=a$+f$+c$+f$+a$
  301. 1460 dd$(2)=b$+f$+a$+f$+d$
  302. 1465 dd$(3)=b$+f$+c$+f$+d$
  303. 1470 dd$(4)=e$+f$+a$+f$+e$
  304. 1475 dd$(5)=e$+f$+c$+f$+e$
  305. 1480 dd$(6)=e$+f$+e$+f$+e$
  306. 1485 fordd=1to6:s2$=left$(s1$,4*dd-3)
  307. 1490 d1$(dd)=s2$+""+dd$(7-dd)
  308. 1495 d2$(dd)=s2$+r1$+dd$(dd):next
  309. 1500 v$(1)="[144]":v$(2)="[146][144]":v$(3)="[144]"
  310. 1505 :
  311. 1510 rem feedback & option strings
  312. 1515 op$="pncgr":forop=1to5
  313. 1520 op$(op)=mid$(op$,op,1)
  314. 1525 s2$=left$(s1$,op+17)
  315. 1530 fb$(op)=s2$+left$(r1$,14)
  316. 1535 op$(op)=s2$+left$(r1$,26)+op$(op)
  317. 1540 next:er$="          [157][157][157][157][157][157][157][157][157][157]"
  318. 1545 pn$(1)="[144]"+op$(1)+"[129]"+op$(2)
  319. 1550 pn$(2)="[129]"+op$(1)+"[144]"+op$(2)
  320. 1555 cg$(1)="[144]"+op$(3)+"[129]"+op$(4)
  321. 1560 cg$(2)="[129]"+op$(3)+"[144]"+op$(4)
  322. 1565 gr$(1)="[144]"+op$(4)+"[129]"+op$(5)
  323. 1570 gr$(2)="[129]"+op$(4)+"[144]"+op$(5)
  324. 1575 :
  325. 1580 sb$="[156]hit [144]spacer[156] to continue"
  326. 1585 bs$="[156]hit [144][146]spacer[156] to continue"
  327. 1590 x$="[146][144]1/2[145]2/3"
  328. 1595 x$=x$+"[145]5/65/62/31/2"
  329. 1600 y$="[144]2/1[145]3/2"
  330. 1605 y$=y$+"[145]6/56/53/22/1"
  331. 1610 i$="[156]instructions [144]y[156]es/[144]n[156]o?..."
  332. 1615 ff$="[144][198]1[156]:forward, [144][198]3[156]:backward"
  333. 1620 rt$=chr$(13)+"":return
  334. 1625 :
  335. 1630 rem read/print instructions
  336. 1635 rem =======================
  337. 1640 :
  338. 1645 dima$(78):open8,8,8,"0:instr*,s,r"
  339. 1650 fora=1to78:input#8,a$,b$:ab$=a$+b$
  340. 1655 a$(a)=ab$:next:close8:fi$="cr/lc*"
  341. 1660 gosub1145:poke53272,23
  342. 1665 :
  343. 1670 p3=0:forp=1to5:j=17:ifp=5thenj=10
  344. 1675 print""spc(35)"[146][144]";p;""
  345. 1680 forp2=1toj:p3=p3+1:printrt$;
  346. 1685 m=val(left$(a$(p3),3)):form2=1tom
  347. 1690 m$=mid$(a$(p3),3*m2+1,3)
  348. 1695 printchr$(val(m$));:next:next
  349. 1700 :
  350. 1705 prints1$"[145]"spc(8)ff$
  351. 1710 getg$:ifg$=""then1710
  352. 1715 ifg$=chr$(133)then1730
  353. 1720 ifg$<>chr$(134)orp3<18then1710
  354. 1725 p=p-2:p3=p3-(j+17)
  355. 1730 gosub1165:next:prints1$"[145][156]"z$
  356. 1735 return
  357. 4975 :
  358. 4980 end
  359. 4985 rem modify program
  360. 4990 rem ==============
  361. 4995 :
  362. 5000 save"re(2)",8:open15,8,15
  363. 5005 print#15,"s0:roll 'em"
  364. 5010 print#15,"r0:roll 'em=re(2)"
  365. 5015 close15:end
  366.